unit textures;

{*
Textures support
TTexture is single texture
TTextureList (global variable TextureList) is list of all loaded textures
In OpenGl, use TTexture.Id of gluint type attribute.

How to Load texture:

  Example 1 (recomended because it will be cached in TTextureList):

    var t : TTexture;
    t := TextureList.Load('images/something.png');
    glSomeDrawingMethod(...,t.Id,...);

  Example 2 (use it only if you for some reason do not want to cache texture and make it completely independent)

    var t : TTexture;
    t := TTexture.Create('images/something.png');
    glSomeDrawingMethod(...,t.Id,...);
    t.Free; // free textures only if you are not using TTextureList
}

interface

uses Classes, SysUtils, Types, ImagingOpenGL, ImagingClasses, gl, glu, glut, debugs, opengls;

type
  TTextureId = gluint;

  // single texture
  TTexture = class
  protected
    FId: TTextureId;
    FWidth: integer;
    FHeight: integer;
    FFileName: string;
    procedure CreateTexture(AFormat: word; AData: pointer);
  public
    constructor Create; overload; virtual;
    constructor Create(AFileName: string); overload; virtual;
    destructor Destroy; override;
    procedure Load(AFileName: string); virtual;
  published
    property Id: TTextureId read FId write FId;
    property Width: integer read FWidth;
    property Height: integer read FHeight;
    property FileName: string read FFileName;
  end;

  // storage for all textures, textures with same FileName will be Loaded only once
  TTextureList = class(TList)
  protected
  public
    constructor Create;
    destructor Destroy; override;
    function AddTexture(var ATexture: TTexture): integer;
    function GetTexture(AIndex: integer): TTexture;
    function FreeTexture(ATexture: TTexture): boolean;
    function Load(AFileName: string): TTexture;
  end;

var
  TextureList: TTextureList;

implementation

procedure glDeleteTextures(n: glsizei; var textureNames: gluint); stdcall; external LibraryGl; {$EXTERNALSYM glDeleteTextures}

// TTexture

constructor TTexture.Create;
{*
Create texture
}
begin
  FId := 0;
  FWidth := 0;
  FHeight := 0;
end;

constructor TTexture.Create(AFileName: string);
{*
Create texture and load it from file
}
begin
  FId := 0;
  FWidth := 0;
  FHeight := 0;
  Load(AFileName);
  FFileName := AFileName;
end;

destructor TTexture.Destroy;
{*
Release texture
FIXME: maybe if texture was created using TTextureList I should also delete it from TTextureList otherwise it will be freed 2 times, or maybe I should not use textures directly and always use list
}
begin
  if FId > 0 then
    //NOTE: is this ok???
    glDeleteTextures(1, FId);
  inherited;
end;

procedure TTexture.CreateTexture(AFormat: word; AData: pointer);
{*
Allocate OpenGL data for texture
}
begin
  Debug.Msg(dlBegin,'TTexture.CreateTexture');
  Debug.Msg(dlParam,'  Width='+IntToStr(FWidth)+' Height='+IntToStr(FHeight)+' format='+IntToStr(AFormat)+' pdata='+IntToStr(Longint(AData)));
  // Create the Texture
  Debug.Msg(dlOther,'  before Id = '+IntToStr(FId));
  glGenTextures(1, @FId);
  glBindTexture(GL_TEXTURE_2D, FId);
  //  Debug.Msg(dlOther,'  after Id = '+IntToStr(FId));
  if FId = 0 then
    raise Exception.Create('glGenTextures(' + IntToStr(AFormat) + ',' + IntToStr(Longint(AData)) + ') after bind returns 0, something is wrong!');
  // glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);
  {Texture blends with object background}
  //glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL);  {Texture does NOT blend with object background}
  { Select a filtering type. BiLinear filtering produces very good results with little performance impact
  GL_NEAREST               - Basic texture (grainy looking texture)
  GL_LINEAR                - BiLinear filtering
  GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture
  GL_LINEAR_MIPMAP_LINEAR  - BiLinear Mipmapped texture
  }
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); { only first two can be used }
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); { all of the above can be used }
  {
  if AFormat = GL_RGBA then
    gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA, Width, Height, GL_RGBA, GL_UNSIGNED_BYTE, pData)
  else
    gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
  }
  if AFormat = GL_RGBA then
    glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, AData) // Use when not wanting mipmaps to be built by openGL
  else
    glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, AData); // Use when not wanting mipmaps to be built by openGL
  Debug.Msg(dlEnd,'UTexture.CreateTexture end');
end;

procedure TTexture.Load(AFileName: string);
{*
Load texture from file using Imaging library
}
var
  i: TSingleImage;
begin
  Debug.Msg(dlBegin, 'TTexture.Load("' + AFileName + '")');
  if not FileExists(AFileName) then
    raise Exception.Create('TTexture.Load: Cannot load texture "'+AFileName+'"');
  i := nil;
  try
    i := TSingleImage.Create;
    i.LoadFromFile(AFileName);
    FWidth := i.Width;
    FHeight := i.Height;
    FId := CreateGLTextureFromImage(i.ImageDataPointer^);
    i.Free;
  except
    i.Free;
    raise;
  end;
end;

// TTextures

constructor TTextureList.Create;
{*
Alocate texture list
}
begin
  inherited;
end;

destructor TTextureList.Destroy;
{*
Release list of textures
}
var i : integer;
begin
  Debug.Msg(dlBegin,'TTextureList.Destroy count='+inttostr(count));
  for i := Count-1 downto 0 do
  begin
    Debug.Msg(dlDetail,'  ['+inttostr(i)+']');
    Debug.Msg(dlDetail,'  releasing '+TTexture(Items[i]).FFileName);
    FreeTexture(TTexture(Items[i]));
    Debug.Msg(dlDetail,'  released');
  end;
  inherited;
  Debug.Msg(dlEnd,'TTextureList.Destroy');
end;

function TTextureList.AddTexture(var ATexture: TTexture): integer;
{*
Add texture to list only if it isn't already there
}
var
  i: integer;
begin
  // isn't texture with same FileName allReady Loaded?
  Debug.Msg(dlDetail,'TTextureList.AddTexture('+IntToStr(Longword(ATexture))+')');
  Debug.Msg(dlDetail,'  FileName = "'+ATexture.FileName+'"');
  result := -1;
  for i := 0 to Count - 1 do
  begin
    Debug.Msg(dlDetail,'  Items['+IntToStr(i)+'] = '+IntToStr(Longword(Items[i])));
    if TTexture(Items[i]).FileName = ATexture.FileName then
      result := i;
  end;
  Debug.Msg(dlDetail,'  index = '+IntToStr(result));
  if result >= 0 then
  begin
    // yes, it is! return it
    Debug.Msg(dlDetail,'  Texture allready Loaded, releasing this one and returning index='+IntToStr(result));
    ATexture.Free;
  end else
  begin
    // no, it's not Loaded yet
    Debug.Msg(dlDetail,'  Texture not Loaded, Loading now');
    result := inherited Add(ATexture);
    Debug.Msg(dlDetail,'  Loaded into index '+IntToStr(result));
  end;
end;

function TTextureList.GetTexture(AIndex: integer): TTexture;
{*
Return texture with given index, range check safe
}
begin
  result := nil;
  if (AIndex >= 0) and (AIndex < Count) then
    result := TTexture(Items[AIndex]);
end;

function TTextureList.Load(AFileName: string): TTexture;
{*
Load texture from file and add it to list
}
var
  index: integer;
  t: TTexture;
  i : integer;
begin
  Debug.Msg(dlBegin, 'TTextureList.Load("' + AFileName + '")');
  // first look if it isn't already loaded, if so, return it instead of loading same image twice
  for i := 0 to Count-1 do
    if TTexture(Items[i]).FFileName = AFileName then
    begin
      Debug.Msg(dlDetail, '  Items['+inttostr(i)+'] is allready loaded as "'+AFileName+'"');
      result := TTexture(Items[i]);
      exit;
    end;
  // load new texture
  result := nil;
  index := -1;
  t := TTexture.Create(AFileName);
  if t <> nil then
    index := AddTexture(t)
  else
    raise Exception.Create('failed to load texture from "' + AFileName + '"');
  result := GetTexture(index);
end;

function TTextureList.FreeTexture(ATexture: TTexture): boolean;
{*
Release texture and Remove it from list
}
var
  i: integer;
begin
  result := false;
  for i := Count - 1 downto 0 do
    if ATexture = Items[i] then
    begin
      TTexture(Items[i]).Free;
      Delete(i);
      result := true;
    end;
end;

initialization

  TextureList := TTextureList.Create;

finalization

  Debug.Msg(dlInfo,'Releasing TextureList');
  TextureList.Free;

end.
